Deutsche Edition 1/Deutsche Edition 1.iso/amok/001-010/amok06/listall/listall.mod

Text File | 1993-11-04 | 6KB | 216 lines

(**********************************************************************

    :Program.       ListAll.mod
    :Author.        Nicolas Benezan
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      [phone]
    :shortcut.      [bne]
    :Version.       1.0b
    :Date.          07.06.88
    :Copyright.  PD
    :Language.      Modula-II
    :Translator. M2Amiga AMSoft
    :Imports.
    :UpDate.
    :Contents.     CLI Command "List opt a"
    :Remark.

**********************************************************************)

MODULE ListAll;

FROM Dos    IMPORT FileLockPtr,sharedLock,Lock,UnLock,Examine,ctrlC,
        ExNext,IoErr,FileInfoBlock,FileInfoBlockPtr,CurrentDir,
                Open,FileHandlePtr,Close,Write,Output,newFile,WaitForChar;
FROM Arts    IMPORT returnVal,wbStarted;
FROM Storage    IMPORT ALLOCATE,DEALLOCATE;
FROM SYSTEM    IMPORT ADR,ADDRESS,LONGSET;
FROM Arguments    IMPORT GetLock,NumArgs,GetArg;
FROM Exec    IMPORT SetSignal,SetExcept;
FROM ASCII    IMPORT lf,cr,sp,nul;
FROM Conversions IMPORT ValToStr;

CONST    Leer="                                                                ";
    TimeOut=20*1000000;
VAR    OldDir,Dir:FileLockPtr;
    Info:FileInfoBlockPtr;
        DummyF,DummyB:LONGINT;
        DummyL:INTEGER;
        Out:FileHandlePtr;
        Arg,Str:ARRAY [0..30] OF CHAR;
        st:LONGINT;
        Quick,Usage:BOOLEAN;

PROCEDURE SetTab(Tab:INTEGER);
BEGIN
  IF Tab>0 THEN
    IF Tab>64 THEN
      Tab:=64;
    END;
    st:=Write(Out,ADR(Leer),Tab);
  END;
END SetTab;

PROCEDURE WriteChar(Ch:CHAR);
BEGIN
  st:=Write(Out,ADR(Ch),1);
END WriteChar;

PROCEDURE WriteInt(Val:LONGINT;Digits:INTEGER);
VAR    err:BOOLEAN;
BEGIN
  ValToStr(Val,TRUE,Str,10,Digits,sp,err);
  st:=Write(Out,ADR(Str),ABS(Digits));
END WriteInt;

PROCEDURE Len(VAR Str:ARRAY OF CHAR):INTEGER;
VAR    Count:INTEGER;
BEGIN
  Count:=0;
  WHILE (Count<HIGH(Str))AND(Str[Count]#nul) DO
    INC(Count);
  END;
  RETURN Count;
END Len;

PROCEDURE WriteString(Str:ADDRESS);
VAR    StringPtr:POINTER TO ARRAY [0..30] OF CHAR;
BEGIN
  StringPtr:=Str;
  st:=Write(Out,Str,Len(StringPtr^));
END WriteString;

PROCEDURE WriteForm(Str:ADDRESS;Width:INTEGER);
VAR    StringPtr:POINTER TO ARRAY [0..30] OF CHAR;
    Pos:INTEGER;
BEGIN
  StringPtr:=Str;
  Pos:=Len(StringPtr^);
  st:=Write(Out,Str,Pos);
  IF Pos<Width THEN
    st:=Write(Out,ADR(Leer),Width-Pos);
  END;
END WriteForm;

PROCEDURE WriteLn;
CONST    ceol=CARDINAL(ORD(lf)+256*ORD(cr));
VAR    eol:CARDINAL;
BEGIN
  eol:=ceol;
  st:=Write(Out,ADR(eol),2);
END WriteLn;

PROCEDURE DispDir(DirLock:FileLockPtr;Tab:INTEGER;VAR Files,Bytes:
        LONGINT);
VAR    ParLock:FileLockPtr;
    Info:FileInfoBlockPtr;
        Status,SubFiles,OwnFiles,SubBytes,OwnBytes:LONGINT;
BEGIN
  OwnFiles:=0;
  OwnBytes:=0;
  Files:=0;
  Bytes:=0;
  ALLOCATE(Info,SIZE(FileInfoBlock));
  IF Info#NIL THEN
    IF (DirLock#NIL)AND(Examine(DirLock,Info)#0) THEN
      IF NOT Quick THEN
        SetTab(Tab);
        WriteString(ADR(Info^.fileName));
        WriteString(ADR(" (dir):"));
        WriteLn;
      END;
      REPEAT
        Status:=ExNext(DirLock,Info);
        IF Status#0 THEN
          IF Info^.entryType<0 THEN
            INC(OwnFiles);
            INC(OwnBytes,Info^.size);
            IF NOT Quick THEN
              SetTab(Tab+2);
              WriteForm(ADR(Info^.fileName),30);
              WriteInt(Info^.size,7);
              WriteLn;
            END;
          ELSE
            IF CurrentDir(DirLock)#NIL THEN END;
            ParLock:=Lock(ADR(Info^.fileName),sharedLock);
            DispDir(ParLock,Tab+2,SubFiles,SubBytes);
            INC(Files,SubFiles);
            INC(Bytes,SubBytes);
            UnLock(ParLock);
          END;
        END;
        IF ctrlC IN SetSignal(LONGSET{},LONGSET{}) THEN
          RETURN;
        END;
      UNTIL Status=0;
      INC(Files,OwnFiles);
      INC(Bytes,OwnBytes);
      SetTab(Tab);
      IF Examine(DirLock,Info)#0 THEN
        WriteString(ADR(Info^.fileName));
        WriteChar(":");
      END;
      WriteInt(OwnBytes,-7);
      WriteChar("/");
      WriteInt(OwnFiles,-7);
      WriteString(ADR("  All:"));
      WriteInt(Bytes,-7);
      WriteChar("/");
      WriteInt(Files,-7);
      WriteLn;
    END;
    DEALLOCATE(Info,SIZE(FileInfoBlock));
  END;
END DispDir;

BEGIN
  IF ctrlC IN SetExcept(LONGSET{},LONGSET{ctrlC}) THEN END;
  ALLOCATE(Info,SIZE(FileInfoBlock));
  IF Info#NIL THEN
    IF wbStarted THEN
      Dir:=GetLock(NumArgs());
      Out:=Open(ADR("CON:0/50/550/100/ListAll V1.0"),newFile);
      Quick:=TRUE;
      Usage:=FALSE;
    ELSE
      Out:=Output();
      OldDir:=CurrentDir(NIL);
      GetArg(NumArgs(),Arg,DummyL);
      Quick:=((Arg[0]="q")OR(Arg[0]="Q"))AND(DummyL=1);
      IF (NumArgs()>1) OR ((NumArgs()>0)AND(NOT Quick)) THEN
        GetArg(1,Arg,DummyL);
        Dir:=CurrentDir(OldDir);
        Dir:=Lock(ADR(Arg),sharedLock);
      ELSE
        Dir:=OldDir;
      END;
      IF (Arg[0]="?")AND(DummyL=1)THEN
        IF Out#NIL THEN
          WriteString(ADR('DIR/S,"Q"/S'));
          WriteLn;
        END;
        Usage:=TRUE;
      END;
    END;
    IF (Out#NIL)AND NOT Usage THEN
      DispDir(Dir,0,DummyF,DummyB);
      IF Dir=NIL THEN
        WriteString(ADR("Directory not found"));
        WriteLn;
      END;
      IF ctrlC IN SetSignal(LONGSET{},LONGSET{}) THEN
        WriteString(ADR("*** Break"));
        WriteLn;
      END;
    END;
    DEALLOCATE(Info,SIZE(FileInfoBlock));
    IF wbStarted THEN
      IF WaitForChar(Out,TimeOut)#0 THEN END;
      Close(Out);
    ELSE
      Dir:=CurrentDir(OldDir);
    END;
  END;
END ListAll.